data <- read.csv("movies_2026.csv", stringsAsFactors = FALSE)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(tidyr)
# Excluímos id, textos, y variables de muy baja varianza (video)
movies_cluster <- data %>%
select(budget, revenue, runtime, popularity, voteAvg, voteCount,
genresAmount, productionCoAmount, productionCountriesAmount,
actorsAmount, castWomenAmount, castMenAmount, releaseYear)
movies_cluster <- movies_cluster %>%
drop_na()
# Escalamiento
movies_scaled <- as.data.frame(scale(movies_cluster))
# REsultado
summary(movies_scaled)
## budget revenue runtime popularity
## Min. :-0.3407 Min. :-0.2604 Min. :-1.3204 Min. :-0.16689
## 1st Qu.:-0.3407 1st Qu.:-0.2604 1st Qu.:-1.1208 1st Qu.:-0.16654
## Median :-0.3407 Median :-0.2604 Median : 0.3961 Median :-0.11744
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000 Mean : 0.00000
## 3rd Qu.:-0.3047 3rd Qu.:-0.2566 3rd Qu.: 0.7354 3rd Qu.:-0.02658
## Max. :13.3159 Max. :25.3009 Max. :13.6495 Max. :73.07935
## voteAvg voteCount genresAmount productionCoAmount
## Min. :-1.1230 Min. :-0.3502 Min. :-1.56094 Min. :-0.9052
## 1st Qu.:-1.1230 1st Qu.:-0.3502 1st Qu.:-0.76048 1st Qu.:-0.9052
## Median : 0.4646 Median :-0.3472 Median : 0.03998 Median :-0.4388
## Mean : 0.0000 Mean : 0.0000 Mean : 0.00000 Mean : 0.0000
## 3rd Qu.: 0.8762 3rd Qu.:-0.1292 3rd Qu.: 0.84045 3rd Qu.: 0.4938
## Max. : 1.8170 Max. :15.4765 Max. : 5.64322 Max. :11.2197
## productionCountriesAmount actorsAmount castWomenAmount
## Min. :-0.5468 Min. :-0.7805 Min. :-0.6937
## 1st Qu.:-0.1004 1st Qu.:-0.6316 1st Qu.:-0.6937
## Median :-0.1004 Median :-0.2841 Median :-0.3360
## Mean : 0.0000 Mean : 0.0000 Mean : 0.0000
## 3rd Qu.:-0.1004 3rd Qu.: 0.2620 3rd Qu.: 0.3795
## Max. :68.6441 Max. :14.7578 Max. :18.2655
## castMenAmount releaseYear
## Min. :-0.1154 Min. :-8.9170
## 1st Qu.:-0.1154 1st Qu.:-0.2983
## Median :-0.1154 Median : 0.6334
## Mean : 0.0000 Mean : 0.0000
## 3rd Qu.:-0.1153 3rd Qu.: 0.6334
## Max. :12.8231 Max. : 0.7111
head(movies_scaled)
## budget revenue runtime popularity voteAvg voteCount genresAmount
## 1 -0.3406744 -0.2604168 0.5757624 -0.1666585 -1.122999 -0.350246 0.03998455
## 2 -0.3406744 -0.2604168 -1.2605496 -0.1666585 -1.122999 -0.350246 -0.76047775
## 3 -0.3406744 -0.2604168 -1.2805095 -0.1667498 -1.122999 -0.350246 -0.76047775
## 4 -0.3406744 -0.2604168 -1.2206298 -0.1666126 -1.122999 -0.350246 0.84044686
## 5 -0.3406744 -0.2604168 -1.0809104 -0.1666445 -1.122999 -0.350246 -0.76047775
## 6 -0.3406743 -0.2604168 -1.0409906 -0.1667038 -1.122999 -0.350246 -0.76047775
## productionCoAmount productionCountriesAmount actorsAmount castWomenAmount
## 1 -0.9051775 -0.546837 -0.3833393 -0.3359697
## 2 -0.9051775 -0.546837 -0.5819120 -0.6936904
## 3 -0.9051775 -0.546837 -0.6315551 -0.6936904
## 4 -0.9051775 -0.546837 -0.4329824 -0.6936904
## 5 -0.9051775 -0.546837 -0.6315551 -0.6936904
## 6 -0.9051775 -0.546837 -0.6315551 -0.6936904
## castMenAmount releaseYear
## 1 -0.1153524 0.7110926
## 2 -0.1154226 0.7110926
## 3 -0.1154226 0.7110926
## 4 -0.1154226 0.7110926
## 5 -0.1154226 0.7110926
## 6 -0.1154226 0.7110926
library(factoextra)
## Loading required package: ggplot2
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(dplyr)
movies_sample <- movies_scaled %>% sample_n(1500)
tendencia <- get_clust_tendency(movies_sample, n = 50, graph = TRUE)
## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# --- RESULTADOS
# Hopkins
cat("Estadístico de Hopkins:", tendencia$hopkins_stat, "\n")
## Estadístico de Hopkins: 0.9522191
# VAT
print(tendencia$plot)
Podemos observar un valor estadístico de hopkins de 0.942, muy cercano
1, lo que indica cierta practicidad en realizar agrupaciones de datos,
la prueba VAT también arroja cómo gráficamente los datos parecen mostrar
ciertas tenedencias, detectamos al menos 4 grupos posibles separados,
por lo que se puede proceder al clustering.
library(factoextra)
library(NbClust)
library(dplyr)
library(ggplot2)
set.seed(666)
movies_sample_opt <- movies_scaled %>% sample_n(1500)
# Metodo del codo
cat("Generando gráfica del Método del Codo...\n")
## Generando gráfica del Método del Codo...
grafica_codo <- fviz_nbclust(movies_sample_opt, kmeans, method = "wss") +
labs(title = "Método del Codo para determinar K óptimo",
x = "Número de clústeres (k)",
y = "Suma de Cuadrados Intra-clúster (WSS)")
print(grafica_codo)
# Metodo nbclust
# Usamos invisible() y capture.output() para evitar que NbClust imprima demasiado texto en el PDF
cat("Ejecutando NbClust para evaluar 30 índices...\n")
## Ejecutando NbClust para evaluar 30 índices...
invisible(capture.output(
resultados_nbclust <- NbClust(data = movies_sample_opt,
distance = "euclidean",
min.nc = 2, max.nc = 10,
method = "kmeans",
index = "all")
))
# === FIX PARA EL ERROR DE FACTOEXTRA ===
# Extraemos la votación mayoritaria manualmente de NbClust
votos <- as.data.frame(table(resultados_nbclust$Best.nc[1, ]))
colnames(votos) <- c("Clusters", "Frecuencia")
# Graficamos con ggplot2
grafica_votos <- ggplot(votos, aes(x = Clusters, y = Frecuencia)) +
geom_bar(stat = "identity", fill = "steelblue", color = "black") +
theme_minimal() +
labs(title = "Número Óptimo de Clústeres - Votación Mayoritaria (NbClust)",
x = "Número de clústeres (k) propuesto",
y = "Frecuencia (Cantidad de índices)") +
theme(plot.title = element_text(face = "bold"))
print(grafica_votos)
Las pruebas realizada con la ayuda de la libreria NbClust dan un por la
regla de la mayoría una recomendación de agrupamiento mediante 4
clusters. Esto es apoyado por el método del codo, dónde gráficamente
observamos un punto de inflección muy claro entre 3 y 4, debido a las
pruebas de Nbcluts decidimos irnos por un total de 4 grupos.
library(dplyr)
library(ggplot2)
library(tidyr)
library(factoextra)
set.seed(666)
indices_muestra <- sample(1:nrow(movies_cluster), 2000)
# Filtramos
movies_sample_cluster <- movies_cluster[indices_muestra, ]
movies_sample_scaled <- as.data.frame(scale(movies_sample_cluster))
# k-medias
km_res <- kmeans(movies_sample_scaled, centers = 4, nstart = 25)
movies_sample_cluster$Cluster_KMeans <- as.factor(km_res$cluster)
# jerarquico
cat("Calculando matriz de distancias para 2000 registros...\n")
## Calculando matriz de distancias para 2000 registros...
distancias <- dist(movies_sample_scaled, method = "euclidean")
cat("Generando árbol jerárquico...\n")
## Generando árbol jerárquico...
hc_res <- hclust(distancias, method = "ward.D2")
grupos_hc <- cutree(hc_res, k = 4)
movies_sample_cluster$Cluster_HC <- as.factor(grupos_hc)
# comparacion
cat("\nMatriz de Confusión (K-Medias vs Jerárquico):\n")
##
## Matriz de Confusión (K-Medias vs Jerárquico):
tabla_comparacion <- table(K_Medias = movies_sample_cluster$Cluster_KMeans,
Jerarquico = movies_sample_cluster$Cluster_HC)
print(tabla_comparacion)
## Jerarquico
## K_Medias 1 2 3 4
## 1 94 835 0 0
## 2 26 0 78 0
## 3 0 0 0 33
## 4 922 8 1 3
# pca
grafico_pca <- fviz_cluster(km_res, data = movies_sample_scaled,
geom = "point",
ellipse.type = "convex",
ggtheme = theme_minimal(),
main = "Agrupamiento K-Medias (Muestra 2000 obs)")
print(grafico_pca)
# grafico radar (mi favorito)
centroides_escalados <- movies_sample_scaled %>%
mutate(Cluster = as.factor(km_res$cluster)) %>%
group_by(Cluster) %>%
summarise_all(mean)
centroides_largo <- centroides_escalados %>%
pivot_longer(cols = -Cluster, names_to = "Variable", values_to = "Media_Escalada")
grafico_radar <- ggplot(centroides_largo, aes(x = Variable, y = Media_Escalada, color = Cluster, group = Cluster)) +
geom_polygon(fill = NA, linewidth = 1) +
geom_point(size = 2) +
geom_line(linewidth = 0.5, linetype = "dashed") +
coord_polar() +
theme_minimal() +
labs(title = "Perfil de los 4 Clusters (K-Medias en Muestra)",
subtitle = "Valores estandarizados: 0 es el promedio de la variable",
y = "Media Estandarizada") +
theme(axis.text.x = element_text(angle = 0, size = 10, face = "bold"),
legend.position = "right")
print(grafico_radar)
Podemos observar que ambos métodos de agrupamiento, tanto k-medias como
jerárquico, muestran una tendencia similar en la asignación de registros
a los clusters, aunque no son idénticos. La matriz de confusión revela
que hay cierta superposición entre los grupos formados por ambos
métodos, lo que sugiere que aunque no coinciden perfectamente, sí
capturan patrones similares en los datos. El gráfico PCA muestra una
clara separación entre los clusters formados por k-medias, mientras que
el gráfico de radar para este caso no es lo más eficiente para
representar visualmente lo que están experimentando los datos.
library(cluster)
library(factoextra)
cat("Calculando el coeficiente de silueta para K-Medias...\n")
## Calculando el coeficiente de silueta para K-Medias...
# silueta
sil_kmeans <- silhouette(km_res$cluster, dist(movies_sample_scaled))
summary(sil_kmeans)
## Silhouette of 2000 units in 4 clusters from silhouette.default(x = km_res$cluster, dist = dist(movies_sample_scaled)) :
## Cluster sizes and average silhouette widths:
## 929 104 33 934
## 0.58556037 0.04467305 0.27439009 0.20627605
## Individual silhouette widths:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.2569 0.2094 0.3186 0.3752 0.6512 0.7185
grafica_silueta <- fviz_silhouette(sil_kmeans,
palette = "jco",
ggtheme = theme_minimal(),
main = "Gráfico de Silueta - Calidad de K-Medias (K=4)")
## cluster size ave.sil.width
## 1 1 929 0.59
## 2 2 104 0.04
## 3 3 33 0.27
## 4 4 934 0.21
print(grafica_silueta)
El análisis de silueta nos permitió evaluar de manera visual qué tan
bien integradas están las películas dentro de sus respectivos grupos. El
resultado mostró un promedio general positivo, lo que confirma que la
mayoría de las películas comparten características fuertes con su propio
segmento y se diferencian adecuadamente de los demás. Aunque se
observaron algunas películas con valores negativos, esto es
completamente normal en esta industria, ya que representan producciones
“fronterizas” que mezclan presupuestos o atributos de distintos grupos.
En conclusión, esta métrica nos asegura que la segmentación en cuatro
grupos es lo suficientemente sólida y confiable para basar en ella
futuras decisiones comerciales.
En esta sección se obtienen reglas de asociación
utilizando el algoritmo Apriori sobre el conjunto de
datos movies_2026.csv.
Se realiza:
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.1 ✔ readr 2.2.0
## ✔ lubridate 1.9.4 ✔ stringr 1.6.0
## ✔ purrr 1.2.1 ✔ tibble 3.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(arules)
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
##
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
##
##
## Attaching package: 'arules'
##
## The following object is masked from 'package:dplyr':
##
## recode
##
## The following objects are masked from 'package:base':
##
## abbreviate, write
library(arulesViz)
movies <- read.csv("movies_2026.csv", encoding = "latin1")
str(movies)
## 'data.frame': 19883 obs. of 28 variables:
## $ id : int 1627085 1626914 1626898 1626808 1626678 1626234 1626010 1625551 1625043 1624457 ...
## $ budget : num 0 0 0 0 0 1 0 0 0 0 ...
## $ genres : chr "Drama|Crime" "Animation" "Animation" "Thriller|Mystery|Documentary" ...
## $ homePage : chr "" "" "" "" ...
## $ productionCompany : chr "" "" "" "" ...
## $ productionCompanyCountry : chr "" "" "" "" ...
## $ productionCountry : chr "" "" "" "" ...
## $ revenue : num 0 0 0 0 0 1 0 0 0 0 ...
## $ runtime : int 95 3 2 5 12 14 39 90 96 106 ...
## $ video : logi FALSE FALSE FALSE FALSE FALSE FALSE ...
## $ director : chr "Javad Hakami" "Kimmy Gatewood" "Kimmy Gatewood" "Felipe Roldán" ...
## $ actors : chr "Mohsen Ghasabian|Aida Mahiani|Mehran Ghafourian|Payam Ahmadinia|Masoud Karamati|Roya Javidnia|Nasim Adabi|Siavash Cheraghipour" "Kameron Jackson|Laura Weaving|sara weaving|Bertha Williams" "Cedric Mitchell|Cajun mills|Laura Williams" "Tomás Tuchsznajder|Matias Junas|Martin Etcheverry|Romeo Jeirfimczuk|Agustin Pulido|Alec Drach|Franco Serio" ...
## $ actorsPopularity : chr "0.3453|0.1664|0.9684|0.3437|0.3713|0.2437|0.2796|0.2639" "0|0.0071|0|0" "0.0193|0|0.0143" "0|0|0|0|0|0|0" ...
## $ actorsCharacter : chr "|||||||" "Prince Charming|Evil Stepmother|Fairy Godmother|Cinderella" "Aladdin|Jafar|Jasmine" "||||||" ...
## $ originalTitle : chr "غوطه ور" "Cinderella" "Aladdin" "EL ANILLO Y EL DECK" ...
## $ title : chr "Immersed" "Cinderella" "Aladdin" "THE RING AND THE DECK" ...
## $ originalLanguage : chr "fa" "en" "en" "es" ...
## $ popularity : num 0.0357 0.0357 0.0214 0.0429 0.0379 ...
## $ releaseDate : chr "2026-02-01" "2026-02-01" "2026-02-01" "2026-02-01" ...
## $ voteAvg : num 0 0 0 0 0 0 0 0 0 0 ...
## $ voteCount : int 0 0 0 0 0 0 0 0 0 0 ...
## $ genresAmount : int 2 1 1 3 1 1 1 1 3 1 ...
## $ productionCoAmount : int 0 0 0 0 0 0 0 0 0 0 ...
## $ productionCountriesAmount: int 0 0 0 0 0 0 0 1 1 0 ...
## $ actorsAmount : int 8 4 3 7 3 3 5 4 5 5 ...
## $ castWomenAmount : int 2 0 0 0 0 0 0 3 1 2 ...
## $ castMenAmount : int 5 0 0 0 0 0 3 0 3 3 ...
## $ releaseYear : int 2026 2026 2026 2026 2026 2026 2026 2026 2026 2026 ...
summary(movies)
## id budget genres homePage
## Min. : 5 Min. : 0 Length:19883 Length:19883
## 1st Qu.: 146220 1st Qu.: 0 Class :character Class :character
## Median : 869623 Median : 0 Mode :character Mode :character
## Mean : 902240 Mean : 9413280
## 3rd Qu.:1589602 3rd Qu.: 1000000
## Max. :1627166 Max. :380000000
##
## productionCompany productionCompanyCountry productionCountry
## Length:19883 Length:19883 Length:19883
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
##
## revenue runtime video director
## Min. :0.000e+00 Min. : 0.00 Mode :logical Length:19883
## 1st Qu.:0.000e+00 1st Qu.: 10.00 FALSE:19313 Class :character
## Median :0.000e+00 Median : 86.00 TRUE :84 Mode :character
## Mean :2.879e+07 Mean : 66.09 NA's :486
## 3rd Qu.:3.306e+05 3rd Qu.:103.00
## Max. :2.847e+09 Max. :750.00
##
## actors actorsPopularity actorsCharacter originalTitle
## Length:19883 Length:19883 Length:19883 Length:19883
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
##
## title originalLanguage popularity releaseDate
## Length:19883 Length:19883 Min. :0.000e+00 Length:19883
## Class :character Class :character 1st Qu.:5.460e-02 Class :character
## Mode :character Mode :character Median :8.502e+00 Mode :character
## Mean :2.625e+01
## 3rd Qu.:2.224e+01
## Max. :1.147e+04
##
## voteAvg voteCount genresAmount productionCoAmount
## Min. : 0.000 Min. : 0.0 Min. : 0.000 Min. : 0.000
## 1st Qu.: 0.000 1st Qu.: 0.0 1st Qu.: 1.000 1st Qu.: 0.000
## Median : 5.400 Median : 6.0 Median : 2.000 Median : 1.000
## Mean : 3.837 Mean : 675.9 Mean : 1.949 Mean : 1.973
## 3rd Qu.: 6.800 3rd Qu.: 423.0 3rd Qu.: 3.000 3rd Qu.: 3.000
## Max. :10.000 Max. :30788.0 Max. :16.000 Max. :89.000
##
## productionCountriesAmount actorsAmount castWomenAmount castMenAmount
## Min. : 0.00 Min. : 0 Min. : 0 Min. : 0
## 1st Qu.: 1.00 1st Qu.: 3 1st Qu.: 0 1st Qu.: 0
## Median : 1.00 Median : 9 Median : 2 Median : 3
## Mean : 1.23 Mean : 1082 Mean : 3517 Mean : 8224
## 3rd Qu.: 1.00 3rd Qu.: 21 3rd Qu.: 6 3rd Qu.: 12
## Max. :155.00 Max. :919590 Max. :922162 Max. :922017
## NA's :37 NA's :162
## releaseYear
## Min. :1902
## 1st Qu.:2013
## Median :2021
## Mean :2017
## 3rd Qu.:2025
## Max. :2026
## NA's :2
Seleccionamos las variables relevantes para minería de reglas:
movies2 <- movies %>%
select(genres, originalLanguage, budget, revenue, runtime,
popularity, voteAvg, voteCount) %>%
drop_na(genres)
El algoritmo Apriori requiere variables categóricas. Se discretizan las variables numéricas usando cuantiles (3 categorías).
movies2 <- movies2 %>%
mutate(
budget_cat = discretize(budget, method = "frequency", categories = 3),
revenue_cat = discretize(revenue, method = "frequency", categories = 3),
runtime_cat = discretize(runtime, method = "frequency", categories = 3),
popularity_cat = discretize(popularity, method = "frequency", categories = 3),
voteAvg_cat = discretize(voteAvg, method = "frequency", categories = 3),
voteCount_cat = discretize(voteCount, method = "frequency", categories = 3)
)
## Warning: There were 10 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `budget_cat = discretize(budget, method = "frequency",
## categories = 3)`.
## Caused by warning in `discretize()`:
## ! Parameter categories is deprecated. Use breaks instead! Also, the default method is now frequency!
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 9 remaining warnings.
movies2 <- movies2 %>%
select(genres, originalLanguage,
budget_cat, revenue_cat, runtime_cat,
popularity_cat, voteAvg_cat, voteCount_cat)
movies_trans <- as(movies2, "transactions")
## Warning: Column(s) 1, 2 not logical or factor. Applying default discretization
## (see '? discretizeDF').
summary(movies_trans)
## transactions as itemMatrix in sparse format with
## 19883 rows (elements/itemsets/transactions) and
## 2934 columns (items) and a density of 0.002726653
##
## most frequent items:
## budget_cat=[0,3.8e+08] revenue_cat=[0,2.85e+09] voteCount_cat=[0,193)
## 19883 19883 13251
## voteAvg_cat=[0,6.4) originalLanguage=en (Other)
## 13091 11961 80995
##
## element (itemset/transaction) length distribution:
## sizes
## 8
## 19883
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 8 8 8 8 8 8
##
## includes extended item information - examples:
## labels variables levels
## 1 genres= genres
## 2 genres=Action genres Action
## 3 genres=Action|Adventure genres Action|Adventure
##
## includes extended transaction information - examples:
## transactionID
## 1 1
## 2 2
## 3 3
rules1 <- apriori(movies_trans,
parameter = list(supp = 0.05,
conf = 0.6,
minlen = 2))
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.6 0.1 1 none FALSE TRUE 5 0.05 2
## maxlen target ext
## 10 rules TRUE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 994
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[2934 item(s), 19883 transaction(s)] done [0.07s].
## sorting and recoding items ... [19 item(s)] done [0.00s].
## creating transaction tree ... done [0.01s].
## checking subsets of size 1 2 3 4 5 6 7 done [0.00s].
## writing ... [1583 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
inspect(sort(rules1, by = "lift")[1:10])
## lhs rhs support confidence coverage lift count
## [1] {originalLanguage=en,
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [2] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [3] {originalLanguage=en,
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [4] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [5] {originalLanguage=en,
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [6] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [7] {originalLanguage=en,
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [8] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [9] {originalLanguage=en,
## runtime_cat=[97,750],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.12387467 0.8774492 0.1411759 2.630628 2463
## [10] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## runtime_cat=[97,750],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.12387467 0.8774492 0.1411759 2.630628 2463
Con soporte alto se generan pocas reglas y suelen estar dominadas por categorías frecuentes.
rules2 <- apriori(movies_trans,
parameter = list(supp = 0.03,
conf = 0.7,
minlen = 2))
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.7 0.1 1 none FALSE TRUE 5 0.03 2
## maxlen target ext
## 10 rules TRUE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 596
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[2934 item(s), 19883 transaction(s)] done [0.07s].
## sorting and recoding items ... [21 item(s)] done [0.00s].
## creating transaction tree ... done [0.01s].
## checking subsets of size 1 2 3 4 5 6 7 done [0.00s].
## writing ... [2078 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
inspect(sort(rules2, by = "lift")[1:10])
## lhs rhs support confidence coverage lift count
## [1] {originalLanguage=en,
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [2] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [3] {originalLanguage=en,
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [4] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.09042901 0.9196931 0.0983252 2.757277 1798
## [5] {originalLanguage=en,
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [6] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [7] {originalLanguage=en,
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [8] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## runtime_cat=[97,750],
## popularity_cat=[16.7,1.15e+04]} => {voteCount_cat=[193,3.08e+04]} 0.13262586 0.8935954 0.1484182 2.679035 2637
## [9] {originalLanguage=en,
## runtime_cat=[97,750],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.12387467 0.8774492 0.1411759 2.630628 2463
## [10] {originalLanguage=en,
## budget_cat=[0,3.8e+08],
## runtime_cat=[97,750],
## voteAvg_cat=[6.4,10]} => {voteCount_cat=[193,3.08e+04]} 0.12387467 0.8774492 0.1411759 2.630628 2463
Se obtiene un mejor equilibrio entre cantidad y calidad de reglas.
rules3 <- apriori(movies_trans,
parameter = list(supp = 0.01,
conf = 0.8,
minlen = 2))
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.8 0.1 1 none FALSE TRUE 5 0.01 2
## maxlen target ext
## 10 rules TRUE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 198
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[2934 item(s), 19883 transaction(s)] done [0.07s].
## sorting and recoding items ... [33 item(s)] done [0.00s].
## creating transaction tree ... done [0.01s].
## checking subsets of size 1 2 3 4 5 6 7 8 done [0.01s].
## writing ... [3746 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
inspect(sort(rules3, by = "lift")[1:10])
## lhs rhs support confidence coverage lift count
## [1] {genres=Animation,
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [2] {genres=Animation,
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4),
## voteCount_cat=[0,193)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [3] {genres=Animation,
## revenue_cat=[0,2.85e+09],
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [4] {genres=Animation,
## budget_cat=[0,3.8e+08],
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [5] {genres=Animation,
## revenue_cat=[0,2.85e+09],
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4),
## voteCount_cat=[0,193)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [6] {genres=Animation,
## budget_cat=[0,3.8e+08],
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4),
## voteCount_cat=[0,193)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [7] {genres=Animation,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [8] {genres=Animation,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## popularity_cat=[0,0.0996),
## voteAvg_cat=[0,6.4),
## voteCount_cat=[0,193)} => {runtime_cat=[0,20)} 0.01076296 0.9511111 0.01131620 2.894680 214
## [9] {genres=Animation,
## popularity_cat=[0,0.0996)} => {runtime_cat=[0,20)} 0.01101443 0.9480519 0.01161797 2.885369 219
## [10] {genres=Animation,
## popularity_cat=[0,0.0996),
## voteCount_cat=[0,193)} => {runtime_cat=[0,20)} 0.01101443 0.9480519 0.01161797 2.885369 219
Se generan muchas reglas. Aunque la confianza es alta, algunas pueden tener bajo soporte práctico.
itemFrequencyPlot(movies_trans, topN = 20, type = "absolute")
Es probable que el idioma inglés (“en”) y categorías de bajo presupuesto o bajo revenue dominen las reglas.
Se elimina el idioma inglés para evaluar si emergen reglas más interesantes.
movies3 <- movies2 %>%
filter(originalLanguage != "en")
movies_trans2 <- as(movies3, "transactions")
## Warning: Column(s) 1, 2 not logical or factor. Applying default discretization
## (see '? discretizeDF').
rules_filtered <- apriori(movies_trans2,
parameter = list(supp = 0.02,
conf = 0.7,
minlen = 2))
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.7 0.1 1 none FALSE TRUE 5 0.02 2
## maxlen target ext
## 10 rules TRUE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 158
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[1324 item(s), 7922 transaction(s)] done [0.03s].
## sorting and recoding items ... [28 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 4 5 6 7 done [0.00s].
## writing ... [2852 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
inspect(sort(rules_filtered, by = "lift")[1:10])
## lhs rhs support confidence coverage lift count
## [1] {originalLanguage=ja,
## voteAvg_cat=[6.4,10],
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02108054 0.8226601 0.02562484 4.394547 167
## [2] {originalLanguage=ja,
## revenue_cat=[0,2.85e+09],
## voteAvg_cat=[6.4,10],
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02108054 0.8226601 0.02562484 4.394547 167
## [3] {originalLanguage=ja,
## budget_cat=[0,3.8e+08],
## voteAvg_cat=[6.4,10],
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02108054 0.8226601 0.02562484 4.394547 167
## [4] {originalLanguage=ja,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## voteAvg_cat=[6.4,10],
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02108054 0.8226601 0.02562484 4.394547 167
## [5] {originalLanguage=ja,
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02234284 0.8194444 0.02726584 4.377369 177
## [6] {originalLanguage=ja,
## revenue_cat=[0,2.85e+09],
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02234284 0.8194444 0.02726584 4.377369 177
## [7] {originalLanguage=ja,
## budget_cat=[0,3.8e+08],
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02234284 0.8194444 0.02726584 4.377369 177
## [8] {originalLanguage=ja,
## budget_cat=[0,3.8e+08],
## revenue_cat=[0,2.85e+09],
## voteCount_cat=[193,3.08e+04]} => {popularity_cat=[16.7,1.15e+04]} 0.02234284 0.8194444 0.02726584 4.377369 177
## [9] {originalLanguage=ja,
## runtime_cat=[20,97),
## voteAvg_cat=[6.4,10]} => {popularity_cat=[16.7,1.15e+04]} 0.02272153 0.8071749 0.02814946 4.311827 180
## [10] {originalLanguage=ja,
## revenue_cat=[0,2.85e+09],
## runtime_cat=[20,97),
## voteAvg_cat=[6.4,10]} => {popularity_cat=[16.7,1.15e+04]} 0.02272153 0.8071749 0.02814946 4.311827 180
Al eliminar una variable dominante:
plot(rules_filtered, method = "graph", engine = "htmlwidget")
## Warning: Too many rules supplied. Only plotting the best 100 using 'lift'
## (change control parameter max if needed).
if(! "psych" %in% installed.packages()) install.packages("psych", depend = TRUE)
if(! "FactoMineR" %in% installed.packages()) install.packages("FactoMineR", depend = TRUE)
if(! "corrplot" %in% installed.packages()) install.packages("corrplot", depend = TRUE)
if(! "fpc" %in% installed.packages()) install.packages("fpc", depend = TRUE)
if(! "factoextra" %in% installed.packages()) install.packages("factoextra", depend = TRUE)
if(! "PCAmixdata" %in% installed.packages()) install.packages("PCAmixdata", depend = TRUE)
if(! "paran" %in% installed.packages()) install.packages("paran", depend = TRUE)
library(psych)
##
## Attaching package: 'psych'
## The following objects are masked from 'package:ggplot2':
##
## %+%, alpha
library(FactoMineR)
library(fpc)
library(factoextra)
library(corrplot)
## corrplot 0.95 loaded
library(PCAmixdata)
library(paran)
## Loading required package: MASS
##
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
##
## select
data <- read.csv("movies_2026.csv", stringsAsFactors = FALSE)
numeric_vars <- c("budget", "revenue", "runtime", "popularity",
"voteAvg", "voteCount", "genresAmount",
"productionCoAmount", "productionCountriesAmount",
"actorsAmount", "castWomenAmount", "castMenAmount")
categorical_vars <- c("genres", "originalLanguage", "video", "director",
"actors", "productionCompany", "productionCountry", "homePage")
numeric_vars_list <- paste(numeric_vars, collapse = ", ")
categorical_vars_list <- paste(categorical_vars, collapse = ", ")
El análisis se realizó sobre un conjunto de 19,883 películas obtenidas de la plataforma “The Movie DB”. A continuación, se describen las variables incluidas en el estudio:
| Variable | Descripción |
|---|---|
| id | Identificador único de la película. |
| popularity | Índice de popularidad calculado semanalmente. |
| budget | Presupuesto de la película (en USD). |
| revenue | Ingresos generados por la película (en USD). |
| runtime | Duración de la película en minutos. |
| voteAvg | Promedio de votos en la plataforma. |
| voteCount | Número de votos recibidos. |
| genresAmount | Cantidad de géneros que representa la película. |
| productionCoAmount | Cantidad de compañías productoras involucradas. |
| productionCountriesAmount | Cantidad de países donde se rodó la película. |
| actorsAmount | Cantidad de actores en el elenco. |
| castWomenAmount | Cantidad de actrices en el elenco. |
| castMenAmount | Cantidad de actores masculinos en el elenco. |
| releaseYear | Año de lanzamiento. |
Para el análisis de componentes principales se utilizarán 12 variables numéricas que aportan información cuantitativa relevante sobre las películas: budget, revenue, runtime, popularity, voteAvg, voteCount, genresAmount, productionCoAmount, productionCountriesAmount, actorsAmount, castWomenAmount, castMenAmount.
Se excluyen:
data_numeric <- data[, numeric_vars]
data_numeric <- na.omit(data_numeric)
str(data_numeric)
## 'data.frame': 19721 obs. of 12 variables:
## $ budget : num 0 0 0 0 0 1 0 0 0 0 ...
## $ revenue : num 0 0 0 0 0 1 0 0 0 0 ...
## $ runtime : int 95 3 2 5 12 14 39 90 96 106 ...
## $ popularity : num 0.0357 0.0357 0.0214 0.0429 0.0379 ...
## $ voteAvg : num 0 0 0 0 0 0 0 0 0 0 ...
## $ voteCount : int 0 0 0 0 0 0 0 0 0 0 ...
## $ genresAmount : int 2 1 1 3 1 1 1 1 3 1 ...
## $ productionCoAmount : int 0 0 0 0 0 0 0 0 0 0 ...
## $ productionCountriesAmount: int 0 0 0 0 0 0 0 1 1 0 ...
## $ actorsAmount : int 8 4 3 7 3 3 5 4 5 5 ...
## $ castWomenAmount : int 2 0 0 0 0 0 0 3 1 2 ...
## $ castMenAmount : int 5 0 0 0 0 0 3 0 3 3 ...
## - attr(*, "na.action")= 'omit' Named int [1:162] 13058 13930 13972 14007 14077 14168 14542 14579 14602 14628 ...
## ..- attr(*, "names")= chr [1:162] "13058" "13930" "13972" "14007" ...
summary(data_numeric)
## budget revenue runtime popularity
## Min. : 0 Min. :0.000e+00 Min. : 0.00 Min. :0.000e+00
## 1st Qu.: 0 1st Qu.:0.000e+00 1st Qu.: 10.00 1st Qu.:5.370e-02
## Median : 0 Median :0.000e+00 Median : 86.00 Median :7.741e+00
## Mean : 9478444 Mean :2.900e+07 Mean : 66.15 Mean :2.614e+01
## 3rd Qu.: 1000000 3rd Qu.:4.227e+05 3rd Qu.:103.00 3rd Qu.:2.198e+01
## Max. :380000000 Max. :2.847e+09 Max. :750.00 Max. :1.147e+04
## voteAvg voteCount genresAmount productionCoAmount
## Min. : 0.000 Min. : 0.0 Min. :0.00 Min. : 0.000
## 1st Qu.: 0.000 1st Qu.: 0.0 1st Qu.:1.00 1st Qu.: 0.000
## Median : 5.400 Median : 6.0 Median :2.00 Median : 1.000
## Mean : 3.819 Mean : 681.3 Mean :1.95 Mean : 1.941
## 3rd Qu.: 6.800 3rd Qu.: 430.0 3rd Qu.:3.00 3rd Qu.: 3.000
## Max. :10.000 Max. :30788.0 Max. :9.00 Max. :26.000
## productionCountriesAmount actorsAmount castWomenAmount castMenAmount
## Min. : 0.000 Min. : 0.00 Min. : 0.000 Min. : 0
## 1st Qu.: 1.000 1st Qu.: 3.00 1st Qu.: 0.000 1st Qu.: 0
## Median : 1.000 Median : 10.00 Median : 2.000 Median : 3
## Mean : 1.225 Mean : 15.72 Mean : 3.878 Mean : 8224
## 3rd Qu.: 1.000 3rd Qu.: 21.00 3rd Qu.: 6.000 3rd Qu.: 12
## Max. :155.000 Max. :313.00 Max. :106.000 Max. :922017
Antes de proceder con el PCA, es necesario evaluar si vale la pena transformar las variables categóricas del dataset para incluirlas en el análisis.
El dataset contiene 8 variables categóricas: genres, originalLanguage, video, director, actors, productionCompany, productionCountry, homePage.
|. Ejemplo: “Drama|Crime”. Cada película puede tener
múltiples géneros.|.cardinalidad <- sapply(categorical_vars, function(v) length(unique(data[[v]])))
data.frame(Variable = names(cardinalidad), Valores_Unicos = cardinalidad, row.names = NULL)
## Variable Valores_Unicos
## 1 genres 2828
## 2 originalLanguage 94
## 3 video 3
## 4 director 13669
## 5 actors 16734
## 6 productionCompany 12235
## 7 productionCountry 1407
## 8 homePage 5489
cat("\nDistribución de 'video':\n")
##
## Distribución de 'video':
table(data$video)
##
## FALSE TRUE
## 19313 84
One-Hot Encoding: Consiste en crear una columna
binaria por cada categoría. Sin embargo, variables como
director y actors tienen miles de valores
únicos, lo que generaría una matriz extremadamente dispersa y de
altísima dimensionalidad, lo cual contradice el objetivo del PCA
(reducir dimensiones).
Separación de géneros: La variable
genres podría separarse por | y codificarse
como columnas binarias por género individual. Aunque es viable, esto
añade múltiples columnas con baja frecuencia para géneros poco
comunes.
PCAmixdata: El paquete PCAmixdata
permite realizar un PCA sobre datos mixtos (numéricos y categóricos).
Sin embargo, requiere que las variables categóricas tengan una cantidad
razonable de niveles. Con la cardinalidad observada en
director, actors y
productionCompany, el análisis sería computacionalmente
costoso y los resultados difíciles de interpretar.
Variable video: Aunque es
trivialmente codificable como 0/1, tiene varianza cercana a cero porque
casi todas las observaciones tienen el mismo valor (FALSE), por lo que
no aportaría al PCA.
No vale la pena incluir las variables categóricas en el PCA. Las razones principales son:
director,
actors y productionCompany generaría una
explosión dimensional.video) tienen
varianza casi nula.Se procederá con las 12 variables numéricas seleccionadas previamente.
Lo primero que vamos a hacer es calcular el determinante de la matriz de correlación. Si este es cercano a 0 significa que hay multicolinealidad, es decir, las variables están relacionadas entre sí.
rcor <- cor(data_numeric, use = "pairwise.complete.obs")
El determinante es: 0.004625.
El valor obtenido (0.004625) es muy cercano a 0, lo que confirma la presencia de multicolinealidad entre las variables. Esto significa que las variables numéricas comparten información redundante, lo cual es una condición favorable para aplicar PCA: el análisis buscará resumir esa redundancia en pocas componentes que capturen la mayor parte de la variabilidad.
Se debe analizar si se puede usar el análisis factorial para formar las combinaciones lineales de las variables. El índice KMO mide la adecuación muestral según la siguiente escala:
resultado_kmo <- KMO(as.matrix(data_numeric))
resultado_kmo
## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = as.matrix(data_numeric))
## Overall MSA = 0.82
## MSA for each item =
## budget revenue runtime
## 0.84 0.75 0.90
## popularity voteAvg voteCount
## 0.92 0.87 0.85
## genresAmount productionCoAmount productionCountriesAmount
## 0.91 0.90 0.57
## actorsAmount castWomenAmount castMenAmount
## 0.81 0.81 0.50
El índice general obtenido (Overall MSA = 0.82) se clasifica como meritorio, lo que indica que los datos son adecuados para un análisis factorial. Esto respalda fuertemente la aplicación de PCA.
Al examinar los valores MSA individuales por variable, se observa que
la mayoría superan 0.8, lo que refuerza su inclusión. Las variables
castMenAmount (MSA = 0.5) y
productionCountriesAmount (MSA = 0.57) presentan los
valores más bajos, en el umbral de lo aceptable, lo que sugiere que
estas variables comparten menos estructura factorial con el resto. No
obstante, al estar por encima de 0.5, se mantienen en el análisis.
H0: La matriz de correlaciones es igual a la matriz identidad.
Se busca rechazar la hipótesis nula de que la matriz de correlaciones es
igual a la matriz identidad y por ende, que existe suficiente
multicolinealidad entre las variables. En una matriz de identidad la
diagonal es 1, y los valores fuera de la diagonal son 0. Esto implica
que no hay más colinealidad entre las variables que la que hay entre
cada variable consigo misma.
resultado_bartlett <- cortest.bartlett(data_numeric)
## R was not square, finding R from data
resultado_bartlett
## $chisq
## [1] 105995.9
##
## $p.value
## [1] 0
##
## $df
## [1] 66
El estadístico chi-cuadrado obtenido es 105,995.9 con 66 grados de libertad, y un valor p de 0. Al ser el valor p prácticamente 0 (mucho menor a 0.05), rechazamos H0 y concluimos que la matriz de correlaciones es significativamente diferente a la matriz identidad. Esto confirma que existe suficiente multicolinealidad entre las variables y que el análisis factorial (y por tanto el PCA) es apropiado para estos datos.
En conjunto, tanto el determinante cercano a 0, el KMO meritorio (0.82) y el rechazo contundente de la prueba de Bartlett confirman que es conveniente aplicar un Análisis de Componentes Principales a este dataset.
A continuación se visualiza la matriz de correlación para identificar las relaciones más fuertes entre variables.
matriz <- cor(data_numeric, use = "pairwise.complete.obs")
corrplot(matriz, method = "color", type = "upper",
tl.cex = 0.7, tl.col = "black",
addCoef.col = "black", number.cex = 0.5)
En la matriz de correlación se pueden identificar varios patrones relevantes:
budget y revenue
presentan una correlación positiva notable, lo cual es esperable:
películas con mayor presupuesto tienden a generar mayores ingresos.budget, revenue y
voteCount forman un bloque correlacionado que
refleja la dimensión comercial de las películas. voteCount
se asocia con mayor visibilidad y presencia en la plataforma.actorsAmount y
castWomenAmount muestran correlación positiva, lo
cual es lógico porque la cantidad de actrices es un subconjunto del
elenco total. Sin embargo, castMenAmount presenta un
comportamiento anómalo con correlaciones bajas respecto al resto de
variables del elenco, posiblemente debido a valores extremos en esta
variable (su media es desproporcionadamente alta respecto a la mediana,
sugiriendo la presencia de outliers severos).runtime se correlaciona moderadamente
con voteAvg, genresAmount y
productionCoAmount, lo que sugiere que las películas más
largas tienden a ser producciones más complejas y mejor evaluadas.popularity muestra correlaciones
débiles con la mayoría de variables, lo que indica que es una métrica
más independiente que depende de factores temporales y externos no
capturados por las demás variables.productionCountriesAmount tiene
correlaciones bajas con el bloque financiero, lo que sugiere que la
cantidad de países de producción no se relaciona linealmente con el
éxito comercial.Para hacer el análisis de componentes principales es necesario
normalizar los datos. La función prcomp lo hace
automáticamente con el parámetro scale = TRUE.
compPrinc <- prcomp(data_numeric, scale = TRUE)
compPrinc
## Standard deviations (1, .., p=12):
## [1] 2.1417968 1.2910075 1.1465400 0.9769159 0.8708341 0.7892329 0.7484470
## [8] 0.6898950 0.6292771 0.5558549 0.4365312 0.4052102
##
## Rotation (n x k) = (12 x 12):
## PC1 PC2 PC3 PC4
## budget 0.342285418 -0.32776715 -0.2201714 -0.02606525
## revenue 0.321001751 -0.40425076 -0.3023611 -0.05327695
## runtime 0.332555927 0.25098687 0.1669475 0.01207898
## popularity 0.119777261 -0.07016405 -0.1535316 0.93630812
## voteAvg 0.318271825 0.30303692 0.1688037 0.09366696
## voteCount 0.343544478 -0.32460352 -0.2140084 -0.11546006
## genresAmount 0.262657432 0.18820240 0.2079680 0.16901057
## productionCoAmount 0.283443240 0.22677105 0.2381743 0.03425571
## productionCountriesAmount 0.092514975 0.46150814 -0.4868708 -0.09912764
## actorsAmount 0.387228908 -0.02185237 0.1302115 -0.16601710
## castWomenAmount 0.357354729 0.09358258 0.0796546 -0.17035392
## castMenAmount 0.001456695 0.39365410 -0.6115913 -0.03758186
## PC5 PC6 PC7 PC8
## budget 0.16753892 0.09270632 0.05719013 0.06290760
## revenue 0.16875832 0.04286622 -0.04405409 -0.09286877
## runtime -0.04609476 0.01213607 -0.36793408 -0.42507970
## popularity -0.27037547 0.01577473 0.04698612 0.02229141
## voteAvg 0.12416892 -0.17044979 -0.35470765 -0.31947089
## voteCount 0.09612636 0.05207196 -0.12226146 -0.11189998
## genresAmount 0.63853719 -0.38183294 0.45125657 0.16677717
## productionCoAmount 0.11961083 0.75030086 -0.09119477 0.45775242
## productionCountriesAmount -0.05977025 0.29956595 0.51531170 -0.39216164
## actorsAmount -0.38334628 -0.18861920 0.08907836 0.21279243
## castWomenAmount -0.51518274 -0.22868284 0.25727617 0.18675624
## castMenAmount 0.07475907 -0.26654588 -0.40597889 0.46940809
## PC9 PC10 PC11 PC12
## budget -0.235457891 -0.658723280 -0.200415842 3.909468e-01
## revenue 0.016687664 -0.006227415 0.469002032 -6.149115e-01
## runtime -0.673846303 0.148944964 0.055533221 2.677972e-02
## popularity 0.001511056 0.059568656 -0.029639711 1.966794e-05
## voteAvg 0.624699237 -0.327042681 0.001935764 -6.593754e-03
## voteCount 0.263254603 0.634849013 -0.219634689 3.968403e-01
## genresAmount -0.111751117 0.161638207 0.009567095 -9.782031e-03
## productionCoAmount 0.067550948 0.055082174 0.079050354 -3.709927e-02
## productionCountriesAmount 0.058193080 -0.004913406 -0.108414258 -6.138742e-02
## actorsAmount -0.015409311 0.000626347 -0.604399118 -4.514158e-01
## castWomenAmount 0.058179493 -0.003113240 0.551596145 3.189729e-01
## castMenAmount -0.081226106 0.033562862 0.003774840 6.414452e-03
El resumen del modelo es el siguiente:
summary(compPrinc)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.1418 1.2910 1.1465 0.97692 0.8708 0.78923 0.74845
## Proportion of Variance 0.3823 0.1389 0.1095 0.07953 0.0632 0.05191 0.04668
## Cumulative Proportion 0.3823 0.5212 0.6307 0.71024 0.7734 0.82535 0.87203
## PC8 PC9 PC10 PC11 PC12
## Standard deviation 0.68989 0.6293 0.55585 0.43653 0.40521
## Proportion of Variance 0.03966 0.0330 0.02575 0.01588 0.01368
## Cumulative Proportion 0.91169 0.9447 0.97044 0.98632 1.00000
También ejecutamos el PCA con FactoMineR::PCA() para
obtener información adicional:
compPrincPCA <- PCA(data_numeric, ncp = ncol(data_numeric), scale.unit = TRUE, graph = FALSE)
summary(compPrincPCA)
##
## Call:
## PCA(X = data_numeric, scale.unit = TRUE, ncp = ncol(data_numeric),
## graph = FALSE)
##
##
## Eigenvalues
## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5 Dim.6 Dim.7
## Variance 4.587 1.667 1.315 0.954 0.758 0.623 0.560
## % of var. 38.227 13.889 10.955 7.953 6.320 5.191 4.668
## Cumulative % of var. 38.227 52.117 63.071 71.024 77.344 82.535 87.203
## Dim.8 Dim.9 Dim.10 Dim.11 Dim.12
## Variance 0.476 0.396 0.309 0.191 0.164
## % of var. 3.966 3.300 2.575 1.588 1.368
## Cumulative % of var. 91.169 94.469 97.044 98.632 100.000
##
## Individuals (the 10 first)
## Dist Dim.1 ctr cos2 Dim.2 ctr
## 1 | 1.822 | -1.072 0.001 0.346 | -0.372 0.000
## 2 | 2.390 | -2.097 0.005 0.770 | -1.013 0.003
## 3 | 2.413 | -2.123 0.005 0.774 | -1.017 0.003
## 4 | 2.365 | -1.606 0.003 0.461 | -0.705 0.002
## 5 | 2.314 | -2.057 0.005 0.790 | -0.967 0.003
## 6 | 2.295 | -2.043 0.005 0.793 | -0.957 0.003
## 7 | 2.089 | -1.839 0.004 0.775 | -0.833 0.002
## 8 | 1.899 | -1.287 0.002 0.459 | -0.321 0.000
## 9 | 2.012 | -0.935 0.001 0.216 | -0.024 0.000
## 10 | 2.082 | -1.266 0.002 0.370 | -0.464 0.001
## cos2 Dim.3 ctr cos2
## 1 0.042 | -0.214 0.000 0.014 |
## 2 0.180 | 0.314 0.000 0.017 |
## 3 0.177 | 0.323 0.000 0.018 |
## 4 0.089 | -0.045 0.000 0.000 |
## 5 0.175 | 0.290 0.000 0.016 |
## 6 0.174 | 0.283 0.000 0.015 |
## 7 0.159 | 0.187 0.000 0.008 |
## 8 0.029 | 0.198 0.000 0.011 |
## 9 0.000 | -0.133 0.000 0.004 |
## 10 0.050 | -0.064 0.000 0.001 |
##
## Variables (the 10 first)
## Dim.1 ctr cos2 Dim.2 ctr cos2
## budget | 0.733 11.716 0.537 | -0.423 10.743 0.179 |
## revenue | 0.688 10.304 0.473 | -0.522 16.342 0.272 |
## runtime | 0.712 11.059 0.507 | 0.324 6.299 0.105 |
## popularity | 0.257 1.435 0.066 | -0.091 0.492 0.008 |
## voteAvg | 0.682 10.130 0.465 | 0.391 9.183 0.153 |
## voteCount | 0.736 11.802 0.541 | -0.419 10.537 0.176 |
## genresAmount | 0.563 6.899 0.316 | 0.243 3.542 0.059 |
## productionCoAmount | 0.607 8.034 0.369 | 0.293 5.143 0.086 |
## productionCountriesAmount | 0.198 0.856 0.039 | 0.596 21.299 0.355 |
## actorsAmount | 0.829 14.995 0.688 | -0.028 0.048 0.001 |
## Dim.3 ctr cos2
## budget 0.252 4.848 0.064 |
## revenue 0.347 9.142 0.120 |
## runtime -0.191 2.787 0.037 |
## popularity 0.176 2.357 0.031 |
## voteAvg -0.194 2.849 0.037 |
## voteCount 0.245 4.580 0.060 |
## genresAmount -0.238 4.325 0.057 |
## productionCoAmount -0.273 5.673 0.075 |
## productionCountriesAmount 0.558 23.704 0.312 |
## actorsAmount -0.149 1.696 0.022 |
Los valores propios (eigenvalues) de cada componente son los siguientes:
valores_propios <- compPrinc$sdev^2
nombres_pc <- paste0("PC", 1:length(valores_propios))
data.frame(Componente = nombres_pc, Valor_Propio = round(valores_propios, 4))
## Componente Valor_Propio
## 1 PC1 4.5873
## 2 PC2 1.6667
## 3 PC3 1.3146
## 4 PC4 0.9544
## 5 PC5 0.7584
## 6 PC6 0.6229
## 7 PC7 0.5602
## 8 PC8 0.4760
## 9 PC9 0.3960
## 10 PC10 0.3090
## 11 PC11 0.1906
## 12 PC12 0.1642
Según la regla de Kaiser, debemos quedarnos con los componentes que tienen valores propios mayores a 1. Los componentes con valor propio menor a 1 explican menos varianza que una sola variable original estandarizada, por lo que no aportan información significativa.
En este caso, los primeros 3 componentes cumplen la regla de Kaiser (PC1 = 4.59, PC2 = 1.67, PC3 = 1.31), mientras que PC4 (0.95) ya cae por debajo de 1.
El gráfico de sedimentación permite identificar visualmente el “codo” donde la varianza explicada por cada componente adicional comienza a estabilizarse.
fviz_eig(compPrinc, addlabels = TRUE, ylim = c(0, 80))
## Warning in geom_bar(stat = "identity", fill = barfill, color = barcolor, :
## Ignoring empty aesthetic: `width`.
fviz_eig(compPrinc, addlabels = TRUE, choice = c("eigenvalue"), ylim = c(0, 5))
## Warning in geom_bar(stat = "identity", fill = barfill, color = barcolor, :
## Ignoring empty aesthetic: `width`.
El primer gráfico muestra el porcentaje de varianza explicada por cada componente, mientras que el segundo muestra los valores propios. Se busca el punto donde la curva se estabiliza (“el codo”), lo que indica que los componentes adicionales ya no aportan información sustancial.
summary(compPrinc)
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.1418 1.2910 1.1465 0.97692 0.8708 0.78923 0.74845
## Proportion of Variance 0.3823 0.1389 0.1095 0.07953 0.0632 0.05191 0.04668
## Cumulative Proportion 0.3823 0.5212 0.6307 0.71024 0.7734 0.82535 0.87203
## PC8 PC9 PC10 PC11 PC12
## Standard deviation 0.68989 0.6293 0.55585 0.43653 0.40521
## Proportion of Variance 0.03966 0.0330 0.02575 0.01588 0.01368
## Cumulative Proportion 0.91169 0.9447 0.97044 0.98632 1.00000
Se busca retener suficientes componentes para explicar una proporción adecuada de la varianza total.
varianza_tabla <- data.frame(
Componente = paste0("PC", 1:length(valores_propios)),
Valor_Propio = round(valores_propios, 4),
Porcentaje_Varianza = round(valores_propios / sum(valores_propios) * 100, 2),
Varianza_Acumulada = round(cumsum(valores_propios / sum(valores_propios) * 100), 2)
)
varianza_tabla
## Componente Valor_Propio Porcentaje_Varianza Varianza_Acumulada
## 1 PC1 4.5873 38.23 38.23
## 2 PC2 1.6667 13.89 52.12
## 3 PC3 1.3146 10.95 63.07
## 4 PC4 0.9544 7.95 71.02
## 5 PC5 0.7584 6.32 77.34
## 6 PC6 0.6229 5.19 82.53
## 7 PC7 0.5602 4.67 87.20
## 8 PC8 0.4760 3.97 91.17
## 9 PC9 0.3960 3.30 94.47
## 10 PC10 0.3090 2.57 97.04
## 11 PC11 0.1906 1.59 98.63
## 12 PC12 0.1642 1.37 100.00
Con los primeros 3 componentes (regla de Kaiser) se explica aproximadamente el 63.1% de la varianza total. Si se desea alcanzar al menos el 80%, es necesario retener 6 componentes (82.5% acumulado). Existe un compromiso entre parsimonia (menos componentes, más fáciles de interpretar) y cobertura de varianza. Para este análisis, se consideran los 3 primeros componentes como los más relevantes por su interpretabilidad y por superar el umbral de Kaiser, aunque se reconoce que no capturan la totalidad de la variabilidad del dataset.
Se calculan los valores propios del PCA basado en los datos reales. Se generan múltiples conjuntos de datos aleatorios con el mismo tamaño que los datos originales (mismo número de variables y observaciones). Se realiza un PCA sobre los datos aleatorios y se extraen los valores propios esperados de cada componente. Se comparan los valores propios reales con los esperados: Si un componente tiene un valor propio mayor que el de los datos simulados, significa que explica más varianza de la que se esperaría por azar, por lo que se retiene. Si el valor propio es menor o igual al de los datos aleatorios, el componente no se retiene porque su explicación de varianza es insignificante.
En los resultados de esta prueba los valores simulados son los de la columna “Adjusted Eigenvalue” y los valores reales son “Unadjusted Eigenvalue”. Se retienen los componentes cuyo valor propio real sea mayor que el simulado.
paran(data_numeric, graph = TRUE)
## Using eigendecomposition of correlation matrix.
##
## Computing: 10% 20% 30% 40% 50% 60% 70% 80% 90% 100%
##
## Results of Horn's Parallel Analysis for component retention
## 360 iterations, using the mean estimate
##
## ──────────────────────────────────────────────────
## Component Adjusted Unadjusted Estimated
## Eigenvalue Eigenvalue Bias
## ──────────────────────────────────────────────────
## 1 4.547173 4.587293 0.040119
## 2 1.636675 1.666700 0.030024
## 3 1.292525 1.314553 0.022028
## ──────────────────────────────────────────────────
## Criterion: retain adjusted eigenvalues > 1.
## (3 components retained)
Se basa en la interpretación de los componentes.
En la siguiente gráfica se ilustra la calidad de la representación de las variables en las dos primeras dimensiones.
fviz_pca_var(compPrinc, col.var = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE
)
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## ℹ The deprecated feature was likely used in the ggpubr package.
## Please report the issue at <https://github.com/kassambara/ggpubr/issues>.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Interpretación del Gráfico de PCA:
Representa la relación entre las variables originales proyectadas en el espacio de los dos primeros componentes principales (Dim1 y Dim2). Vamos a analizarlo paso a paso.
Ejes del gráfico. El Eje X (Dim1) representa el primer componente principal (PC1) y el Eje Y (Dim2) representa el segundo componente principal (PC2). Cada eje indica el porcentaje de varianza total que explica. En conjunto, los dos primeros componentes capturan una proporción de la variabilidad total de los datos.
Longitud de las Flechas (Vectores). Cada flecha representa una variable original. La longitud de la flecha indica qué tan bien está representada la variable en el espacio de PC1 y PC2. Flechas largas indican que esas variables están bien representadas en los primeros dos componentes. Flechas cortas indican que la variable no está completamente explicada por PC1 y PC2 y puede necesitar más dimensiones para su interpretación.
Dirección de las Flechas. Las variables con vectores apuntando en la misma dirección están correlacionadas positivamente. Las variables con vectores opuestos tienen una correlación negativa. Las variables con vectores perpendiculares (ángulo de 90°) están débilmente correlacionadas o no tienen relación.
Color de las Flechas (cos2 - Calidad de Representación). El color indica el cos2, que mide la calidad de la representación de cada variable en el espacio de los componentes. Colores cálidos (rojo/naranja) representan variables bien explicadas por los primeros dos componentes (cos2 alto). Colores fríos (azul/verde) representan variables poco explicadas, lo que sugiere que necesitan más dimensiones para su correcta interpretación.
Relación con los Componentes Principales. Se identifica qué variables tienen las cargas más altas en cada dimensión para interpretar conceptualmente qué representa cada componente.
El biplot combina la representación de las observaciones y las variables en el espacio de los componentes principales.
fviz_pca_biplot(compPrinc, repel = FALSE,
col.var = "#FC4E07",
col.ind = "#00AFBB",
alpha.ind = 0.1)
Los siguientes gráficos muestran qué variables contribuyen más a cada una de las primeras tres dimensiones. La línea roja discontinua representa la contribución esperada si todas las variables contribuyeran por igual.
fviz_contrib(compPrinc, choice = "var", axes = 1, top = 10)
fviz_contrib(compPrinc, choice = "var", axes = 2, top = 10)
fviz_contrib(compPrinc, choice = "var", axes = 3, top = 10)
El siguiente gráfico muestra la calidad de la representación de cada variable en cada componente. Valores altos de cos2 indican que la variable está bien capturada por ese componente.
var <- get_pca_var(compPrinc)
corrplot(var$cos2, is.corr = FALSE)
Con base en los gráficos de contribución, las cargas factoriales y la calidad de representación, se interpretan los componentes retenidos.
compPrinc$rotation
## PC1 PC2 PC3 PC4
## budget 0.342285418 -0.32776715 -0.2201714 -0.02606525
## revenue 0.321001751 -0.40425076 -0.3023611 -0.05327695
## runtime 0.332555927 0.25098687 0.1669475 0.01207898
## popularity 0.119777261 -0.07016405 -0.1535316 0.93630812
## voteAvg 0.318271825 0.30303692 0.1688037 0.09366696
## voteCount 0.343544478 -0.32460352 -0.2140084 -0.11546006
## genresAmount 0.262657432 0.18820240 0.2079680 0.16901057
## productionCoAmount 0.283443240 0.22677105 0.2381743 0.03425571
## productionCountriesAmount 0.092514975 0.46150814 -0.4868708 -0.09912764
## actorsAmount 0.387228908 -0.02185237 0.1302115 -0.16601710
## castWomenAmount 0.357354729 0.09358258 0.0796546 -0.17035392
## castMenAmount 0.001456695 0.39365410 -0.6115913 -0.03758186
## PC5 PC6 PC7 PC8
## budget 0.16753892 0.09270632 0.05719013 0.06290760
## revenue 0.16875832 0.04286622 -0.04405409 -0.09286877
## runtime -0.04609476 0.01213607 -0.36793408 -0.42507970
## popularity -0.27037547 0.01577473 0.04698612 0.02229141
## voteAvg 0.12416892 -0.17044979 -0.35470765 -0.31947089
## voteCount 0.09612636 0.05207196 -0.12226146 -0.11189998
## genresAmount 0.63853719 -0.38183294 0.45125657 0.16677717
## productionCoAmount 0.11961083 0.75030086 -0.09119477 0.45775242
## productionCountriesAmount -0.05977025 0.29956595 0.51531170 -0.39216164
## actorsAmount -0.38334628 -0.18861920 0.08907836 0.21279243
## castWomenAmount -0.51518274 -0.22868284 0.25727617 0.18675624
## castMenAmount 0.07475907 -0.26654588 -0.40597889 0.46940809
## PC9 PC10 PC11 PC12
## budget -0.235457891 -0.658723280 -0.200415842 3.909468e-01
## revenue 0.016687664 -0.006227415 0.469002032 -6.149115e-01
## runtime -0.673846303 0.148944964 0.055533221 2.677972e-02
## popularity 0.001511056 0.059568656 -0.029639711 1.966794e-05
## voteAvg 0.624699237 -0.327042681 0.001935764 -6.593754e-03
## voteCount 0.263254603 0.634849013 -0.219634689 3.968403e-01
## genresAmount -0.111751117 0.161638207 0.009567095 -9.782031e-03
## productionCoAmount 0.067550948 0.055082174 0.079050354 -3.709927e-02
## productionCountriesAmount 0.058193080 -0.004913406 -0.108414258 -6.138742e-02
## actorsAmount -0.015409311 0.000626347 -0.604399118 -4.514158e-01
## castWomenAmount 0.058179493 -0.003113240 0.551596145 3.189729e-01
## castMenAmount -0.081226106 0.033562862 0.003774840 6.414452e-03
A partir de la matriz de rotación (loadings), se puede interpretar cada componente principal:
PC1 - Escala general de la película (38.2% de
varianza). Este componente presenta cargas positivas en
prácticamente todas las variables: actorsAmount (0.39),
castWomenAmount (0.36), voteCount (0.34),
budget (0.34), runtime (0.33),
revenue (0.32), voteAvg (0.32),
productionCoAmount (0.28) y genresAmount
(0.26). Es un componente de tamaño o magnitud general:
películas con valores altos en PC1 son producciones grandes en todos los
sentidos (mayor presupuesto, más ingresos, elencos más numerosos, mayor
duración, más votos y mejor calificación). Las variables con menor peso
son popularity (0.12) y castMenAmount (0.001),
lo que indica que estas dos variables no se alinean con esta dimensión
general. Es el patrón típico del primer componente en PCA, que captura
la “escala” o “importancia” global del fenómeno.
PC2 - Producción internacional/artística vs. éxito
comercial (13.9% de varianza). Este componente contrasta dos
perfiles de películas a través de cargas de signo opuesto. En el lado
positivo: productionCountriesAmount (0.46),
castMenAmount (0.39), voteAvg (0.30),
runtime (0.25) — variables que describen producciones
internacionales, con mayor duración y mejor evaluadas cualitativamente.
En el lado negativo: revenue (-0.40), budget
(-0.33), voteCount (-0.32) — variables que representan el
éxito comercial medido en dinero y volumen de votos. Este componente
diferencia entre películas artísticas o de cine
independiente/internacional (rodadas en múltiples países, bien
evaluadas pero con menor presupuesto) y blockbusters
comerciales (alto presupuesto, altos ingresos, muchos votos
pero no necesariamente mejor calificación).
PC3 - Estructura multinacional de producción (11.0% de
varianza). Dominado por cargas negativas fuertes en
castMenAmount (-0.61) y
productionCountriesAmount (-0.49), y una carga negativa
moderada en revenue (-0.30). En el lado positivo, las
cargas son más modestas: productionCoAmount (0.24),
genresAmount (0.21). Este componente captura la dimensión
de producción multinacional con elencos masculinos
grandes en contraposición con producciones con más
compañías y diversidad de géneros. La fuerte influencia de
castMenAmount debe interpretarse con cautela dado los
valores extremos observados en esta variable (media desproporcionada
respecto a la mediana).
varianza <- summary(compPrinc)
varianza
## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.1418 1.2910 1.1465 0.97692 0.8708 0.78923 0.74845
## Proportion of Variance 0.3823 0.1389 0.1095 0.07953 0.0632 0.05191 0.04668
## Cumulative Proportion 0.3823 0.5212 0.6307 0.71024 0.7734 0.82535 0.87203
## PC8 PC9 PC10 PC11 PC12
## Standard deviation 0.68989 0.6293 0.55585 0.43653 0.40521
## Proportion of Variance 0.03966 0.0330 0.02575 0.01588 0.01368
## Cumulative Proportion 0.91169 0.9447 0.97044 0.98632 1.00000
Viabilidad del PCA: Las pruebas previas confirmaron la conveniencia de aplicar PCA. El determinante de la matriz de correlación cercano a 0 (0.004625) indica multicolinealidad. El índice KMO de 0.82 (meritorio) y el rechazo contundente de la prueba de Bartlett (p-value = 0) respaldan la adecuación de los datos para el análisis factorial.
Dimensionalidad reducida: Según la regla de Kaiser, se retienen 3 componentes principales que explican el 63.1% de la varianza total. Si se requiriera mayor cobertura (80%), serían necesarios 6 componentes. Las 12 variables originales se resumen en 3 ejes decorrelacionados, facilitando el análisis.
Interpretabilidad de los componentes:
Observaciones sobre la calidad de los datos: La
variable castMenAmount presenta valores extremos (media
desproporcionada respecto a la mediana, con un máximo de 922,017) que
afectan su comportamiento en el PCA. Esto se refleja en su MSA bajo
(0.50) y su carga casi nula en PC1. Para futuros análisis, se recomienda
investigar y tratar estos outliers antes de aplicar PCA.
Utilidad para modelos predictivos: Al utilizar los componentes principales en lugar de las 12 variables originales, se reduce la dimensionalidad, se eliminan problemas de multicolinealidad y se facilita la construcción de modelos de predicción futuros con variables decorrelacionadas.
Recomendaciones para CineVision Studios:
castMenAmount
y productionCountriesAmount para corregir posibles errores
de registro.